home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / src / pt-cmd.cc < prev    next >
C/C++ Source or Header  |  1997-03-07  |  16KB  |  791 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. #if defined (__GNUG__)
  24. #pragma implementation
  25. #endif
  26.  
  27. #ifdef HAVE_CONFIG_H
  28. #include <config.h>
  29. #endif
  30.  
  31. #include <iostream.h>
  32.  
  33. // Nonzero means we're breaking out of a loop or function body.
  34. int breaking = 0;
  35.  
  36. // Nonzero means we're jumping to the end of a loop.
  37. int continuing = 0;
  38.  
  39. // Nonzero means we're returning from a function.  Global because it
  40. // is also needed in tree-expr.cc.
  41. int returning = 0;
  42.  
  43. #include "error.h"
  44. #include "gripes.h"
  45. #include "oct-map.h"
  46. #include "symtab.h"
  47. #include "pt-cmd.h"
  48. #include "ov.h"
  49. #include "pt-exp.h"
  50. #include "pt-fvc.h"
  51. #include "pt-misc.h"
  52. #include "pt-mvr.h"
  53. #include "pt-walk.h"
  54. #include "unwind-prot.h"
  55. #include "variables.h"
  56.  
  57. // Decide if it's time to quit a for or while loop.
  58. static inline bool
  59. quit_loop_now (void)
  60. {
  61.   // Maybe handle `continue N' someday...
  62.  
  63.   if (continuing)
  64.     continuing--;
  65.  
  66.   bool quit = (returning || breaking || continuing);
  67.  
  68.   if (breaking)
  69.     breaking--;
  70.  
  71.   return quit;
  72. }
  73.  
  74. // Global.
  75.  
  76. tree_global_command::~tree_global_command (void)
  77. {
  78.   delete init_list;
  79. }
  80.  
  81. void
  82. tree_global_command::eval (void)
  83. {
  84.   if (init_list)
  85.     init_list->eval ();
  86.  
  87.   if (error_state > 0)
  88.     ::error ("evaluating global command near line %d, column %d",
  89.          line (), column ());
  90. }
  91.  
  92. void
  93. tree_global_command::accept (tree_walker& tw)
  94. {
  95.   tw.visit_global_command (*this);
  96. }
  97.  
  98. // While.
  99.  
  100. tree_while_command::~tree_while_command (void)
  101. {
  102.   delete expr;
  103.   delete list;
  104. }
  105.  
  106. void
  107. tree_while_command::eval (void)
  108. {
  109.   if (error_state)
  110.     return;
  111.  
  112.   if (! expr)
  113.     panic_impossible ();
  114.  
  115.   for (;;)
  116.     {
  117.       if (expr->is_logically_true ("while"))
  118.     {
  119.       if (list)
  120.         {
  121.           list->eval (1);
  122.           if (error_state)
  123.         {
  124.           eval_error ();
  125.           return;
  126.         }
  127.         }
  128.  
  129.       if (quit_loop_now ())
  130.         break;
  131.     }
  132.       else
  133.     break;
  134.     }
  135. }
  136.  
  137. void
  138. tree_while_command::eval_error (void)
  139. {
  140.   if (error_state > 0)
  141.     ::error ("evaluating while command near line %d, column %d",
  142.          line (), column ());
  143. }
  144.  
  145. void
  146. tree_while_command::accept (tree_walker& tw)
  147. {
  148.   tw.visit_while_command (*this);
  149. }
  150.  
  151. // For.
  152.  
  153. tree_for_command::~tree_for_command (void)
  154. {
  155.   delete id;
  156.   delete id_list;
  157.   delete expr;
  158.   delete list;
  159. }
  160.  
  161. inline void
  162. tree_for_command::do_for_loop_once (tree_return_list *lst,
  163.                     const octave_value_list& rhs, bool& quit)
  164. {
  165.   quit = false;
  166.  
  167.   tree_oct_obj *tmp = new tree_oct_obj (rhs);
  168.   tree_multi_assignment_expression tmp_ass (lst, tmp, 1);
  169.   tmp_ass.eval (false);
  170.  
  171.   if (error_state)
  172.     {
  173.       eval_error ();
  174.       return;
  175.     }
  176.  
  177.   if (list)
  178.     {
  179.       list->eval (1);
  180.       if (error_state)
  181.     {
  182.       eval_error ();
  183.       quit = true;
  184.       return;
  185.     }
  186.     }
  187.  
  188.   quit = quit_loop_now ();
  189. }
  190.  
  191. inline void
  192. tree_for_command::do_for_loop_once (tree_index_expression *idx_expr,
  193.                     const octave_value& rhs, bool& quit)
  194. {
  195.   quit = false;
  196.  
  197.   octave_value *tmp = new octave_value (rhs);
  198.   tree_simple_assignment_expression tmp_ass (idx_expr, tmp, true);
  199.   tmp_ass.eval (false);
  200.  
  201.   if (error_state)
  202.     {
  203.       eval_error ();
  204.       return;
  205.     }
  206.  
  207.   if (list)
  208.     {
  209.       list->eval (1);
  210.       if (error_state)
  211.     {
  212.       eval_error ();
  213.       quit = true;
  214.       return;
  215.     }
  216.     }
  217.  
  218.   quit = quit_loop_now ();
  219. }
  220.  
  221. inline void
  222. tree_for_command::do_for_loop_once (tree_identifier *ident,
  223.                     octave_value& rhs, bool& quit)
  224. {
  225.   quit = false;
  226.  
  227.   octave_variable_reference tmp (ident);
  228.  
  229.   if (error_state)
  230.     {
  231.       eval_error ();
  232.       return;
  233.     }
  234.  
  235.   tmp.assign (rhs);
  236.  
  237.   if (list)
  238.     {
  239.       list->eval (1);
  240.       if (error_state)
  241.     {
  242.       eval_error ();
  243.       quit = true;
  244.       return;
  245.     }
  246.     }
  247.  
  248.   quit = quit_loop_now ();
  249. }
  250.  
  251. #define DO_LOOP(val) \
  252.   do \
  253.     { \
  254.       if (ident) \
  255.     for (int i = 0; i < steps; i++) \
  256.       { \
  257.         octave_value rhs (val); \
  258.         bool quit = false; \
  259.         do_for_loop_once (ident, rhs, quit); \
  260.         if (quit) \
  261.           break; \
  262.       } \
  263.       else if (id_list) \
  264.     for (int i = 0; i < steps; i++) \
  265.       { \
  266.         octave_value_list rhs (val); \
  267.         bool quit = false; \
  268.         do_for_loop_once (id_list, rhs, quit); \
  269.         if (quit) \
  270.           break; \
  271.       } \
  272.       else \
  273.     for (int i = 0; i < steps; i++) \
  274.       { \
  275.         octave_value rhs (val); \
  276.         bool quit = false; \
  277.         do_for_loop_once (tmp_id, rhs, quit); \
  278.         if (quit) \
  279.           break; \
  280.       } \
  281.     } \
  282.   while (0)
  283.  
  284. void
  285. tree_for_command::eval (void)
  286. {
  287.   if (error_state || ! expr)
  288.     return;
  289.  
  290.   octave_value tmp_expr = expr->eval (false);
  291.  
  292.   if (error_state || tmp_expr.is_undefined ())
  293.     {
  294.       eval_error ();
  295.       return;
  296.     }
  297.  
  298.   tree_index_expression *tmp_id = id;
  299.   if (id_list && id_list->length () == 1)
  300.     tmp_id = id_list->front ();
  301.  
  302.   tree_identifier *ident = 0;
  303.   if (tmp_id && ! tmp_id->arg_list ())
  304.     {
  305.       tree_indirect_ref *idr = tmp_id->ident ();
  306.       if (idr->is_identifier_only ())
  307.     ident = idr->ident ();
  308.     }
  309.  
  310.   if (id_list && ! ident && ! tmp_expr.is_map ())
  311.     {
  312.       error ("in statement `for [X, Y] = VAL', VAL must be a structure");
  313.       return;
  314.     }
  315.  
  316.   if (tmp_expr.is_scalar_type ())
  317.     {
  318.       bool quit = false;
  319.       if (ident)
  320.     do_for_loop_once (ident, tmp_expr, quit);
  321.       else if (id_list)
  322.     {
  323.       octave_value_list rhs (tmp_expr);
  324.       do_for_loop_once (id_list, rhs, quit);
  325.     }
  326.       else
  327.     do_for_loop_once (tmp_id, tmp_expr, quit);
  328.     }
  329.   else if (tmp_expr.is_matrix_type ())
  330.     {
  331.       Matrix m_tmp;
  332.       ComplexMatrix cm_tmp;
  333.       int nr;
  334.       int steps;
  335.       if (tmp_expr.is_real_matrix ())
  336.     {
  337.       m_tmp = tmp_expr.matrix_value ();
  338.       nr = m_tmp.rows ();
  339.       steps = m_tmp.columns ();
  340.     }
  341.       else
  342.     {
  343.       cm_tmp = tmp_expr.complex_matrix_value ();
  344.       nr = cm_tmp.rows ();
  345.       steps = cm_tmp.columns ();
  346.     }
  347.  
  348.       if (tmp_expr.is_real_matrix ())
  349.     {
  350.       if (nr == 1)
  351.         DO_LOOP(m_tmp (0, i));
  352.       else
  353.         DO_LOOP(m_tmp.extract (0, i, nr-1, i));
  354.     }
  355.       else
  356.     {
  357.       if (nr == 1)
  358.         DO_LOOP(cm_tmp (0, i));
  359.       else
  360.         DO_LOOP(cm_tmp.extract (0, i, nr-1, i));
  361.     }
  362.     }
  363.   else if (tmp_expr.is_string ())
  364.     {
  365.       gripe_string_invalid ();
  366.     }
  367.   else if (tmp_expr.is_range ())
  368.     {
  369.       Range rng = tmp_expr.range_value ();
  370.  
  371.       int steps = rng.nelem ();
  372.       double b = rng.base ();
  373.       double increment = rng.inc ();
  374.  
  375.       if (ident)
  376.     {
  377.       for (int i = 0; i < steps; i++)
  378.         {
  379.           double tmp_val = b + i * increment;
  380.  
  381.           octave_value rhs (tmp_val);
  382.  
  383.           bool quit = false;
  384.           do_for_loop_once (ident, rhs, quit);
  385.  
  386.           if (quit)
  387.         break;
  388.         }
  389.     }
  390.       else if (id_list)
  391.     {
  392.       for (int i = 0; i < steps; i++)
  393.         {
  394.           double tmp_val = b + i * increment;
  395.  
  396.           octave_value_list rhs (tmp_val);
  397.  
  398.           bool quit = false;
  399.           do_for_loop_once (id_list, rhs, quit);
  400.  
  401.           if (quit)
  402.         break;
  403.         }
  404.     }
  405.       else
  406.     {
  407.       for (int i = 0; i < steps; i++)
  408.         {
  409.           double tmp_val = b + i * increment;
  410.  
  411.           octave_value rhs (tmp_val);
  412.  
  413.           bool quit = false;
  414.           do_for_loop_once (tmp_id, rhs, quit);
  415.  
  416.           if (quit)
  417.         break;
  418.         }
  419.     }
  420.     }
  421.   else if (tmp_expr.is_map ())
  422.     {
  423.       if (ident)
  424.     {
  425.       Octave_map tmp_val (tmp_expr.map_value ());
  426.  
  427.       for (Pix p = tmp_val.first (); p != 0; tmp_val.next (p))
  428.         {
  429.           octave_value rhs (tmp_val.contents (p));
  430.  
  431.           bool quit = false;
  432.           do_for_loop_once (ident, rhs, quit);
  433.  
  434.           if (quit)
  435.         break;
  436.         }
  437.     }
  438.       else if (id_list)
  439.     {
  440.       // Cycle through structure elements.  First element of
  441.       // id_list is set to value and the second is set to the name
  442.       // of the structure element.
  443.  
  444.       Octave_map tmp_val (tmp_expr.map_value ());
  445.  
  446.       for (Pix p = tmp_val.first (); p != 0; tmp_val.next (p))
  447.         {
  448.           octave_value_list tmp;
  449.           tmp (1) = tmp_val.key (p);
  450.           tmp (0) = tmp_val.contents (p);
  451.  
  452.           bool quit = false;
  453.           do_for_loop_once (id_list, tmp, quit);
  454.  
  455.           if (quit)
  456.         break;
  457.         }
  458.     }
  459.       else
  460.     {
  461.       Octave_map tmp_val (tmp_expr.map_value ());
  462.  
  463.       for (Pix p = tmp_val.first (); p != 0; tmp_val.next (p))
  464.         {
  465.           octave_value rhs = tmp_val.contents (p);
  466.  
  467.           bool quit = false;
  468.           do_for_loop_once (tmp_id, rhs, quit);
  469.  
  470.           if (quit)
  471.         break;
  472.         }
  473.     }
  474.     }
  475.   else
  476.     {
  477.       ::error ("invalid type in for loop expression near line %d, column %d",
  478.            line (), column ());
  479.     }
  480. }
  481.  
  482. void
  483. tree_for_command::eval_error (void)
  484. {
  485.   if (error_state > 0)
  486.     ::error ("evaluating for command near line %d, column %d",
  487.          line (), column ());
  488. }
  489.  
  490. void
  491. tree_for_command::accept (tree_walker& tw)
  492. {
  493.   tw.visit_for_command (*this);
  494. }
  495.  
  496. // If.
  497.  
  498. tree_if_command::~tree_if_command (void)
  499. {
  500.   delete list;
  501. }
  502.  
  503. void
  504. tree_if_command::eval (void)
  505. {
  506.   if (list)
  507.     list->eval ();
  508.  
  509.   if (error_state > 0)
  510.     ::error ("evaluating if command near line %d, column %d",
  511.          line (), column ());
  512. }
  513.  
  514. void
  515. tree_if_command::accept (tree_walker& tw)
  516. {
  517.   tw.visit_if_command (*this);
  518. }
  519.  
  520. // Switch.
  521.  
  522. tree_switch_command::~tree_switch_command (void)
  523. {
  524.   delete expr;
  525.   delete list;
  526. }
  527.  
  528. void
  529. tree_switch_command::eval (void)
  530. {
  531.   if (expr)
  532.     {
  533.       octave_value val = expr->eval (0);
  534.  
  535.       if (! error_state)
  536.     {
  537.       if (list)
  538.         list->eval (val);
  539.  
  540.       if (error_state)
  541.         eval_error ();
  542.     }
  543.       else
  544.     eval_error ();
  545.     }
  546.   else
  547.     ::error ("missing value in switch command near line %d, column %d",
  548.          line (), column ());
  549. }
  550.  
  551. void
  552. tree_switch_command::eval_error (void)
  553. {
  554.   ::error ("evaluating switch command near line %d, column %d",
  555.        line (), column ());
  556. }
  557.  
  558. void
  559. tree_switch_command::accept (tree_walker& tw)
  560. {
  561.   tw.visit_switch_command (*this);
  562. }
  563.  
  564. // Simple exception handling.
  565.  
  566. tree_try_catch_command::~tree_try_catch_command (void)
  567. {
  568.   delete try_code;
  569.   delete catch_code;
  570. }
  571.  
  572. static void
  573. do_catch_code (void *ptr)
  574. {
  575.   tree_statement_list *list = (tree_statement_list *) ptr;
  576.  
  577.   // Set up for letting the user print any messages from errors that
  578.   // occurred in the body of the try_catch statement.
  579.  
  580.   buffer_error_messages = 0;
  581.   bind_global_error_variable ();
  582.   add_unwind_protect (clear_global_error_variable, 0);
  583.  
  584.   // Similarly, if we have seen a return or break statement, allow all
  585.   // the catch code to run before returning or handling the break.
  586.   // We don't have to worry about continue statements because they can
  587.   // only occur in loops.
  588.  
  589.   unwind_protect_int (returning);
  590.   returning = 0;
  591.  
  592.   unwind_protect_int (breaking);
  593.   breaking = 0;
  594.  
  595.   if (list)
  596.     list->eval (true);
  597.  
  598.   // This is the one for breaking.  (The unwind_protects are popped
  599.   // off the stack in the reverse of the order they are pushed on).
  600.  
  601.   // XXX FIXME XXX -- inside a try-catch, should break work like
  602.   // a return, or just jump to the end of the try_catch block?
  603.   // The following code makes it just jump to the end of the block.
  604.  
  605.   run_unwind_protect ();
  606.   if (breaking)
  607.     breaking--;
  608.  
  609.   // This is the one for returning.
  610.  
  611.   if (returning)
  612.     discard_unwind_protect ();
  613.   else
  614.     run_unwind_protect ();
  615.  
  616.   run_unwind_protect ();
  617. }
  618.  
  619. void
  620. tree_try_catch_command::eval (void)
  621. {
  622.   begin_unwind_frame ("tree_try_catch::eval");
  623.  
  624.   add_unwind_protect (do_catch_code, catch_code);
  625.  
  626.   if (catch_code)
  627.     {
  628.       unwind_protect_int (buffer_error_messages);
  629.       buffer_error_messages = 1;
  630.     }
  631.  
  632.   if (try_code)
  633.     try_code->eval (true);
  634.  
  635.   if (catch_code && error_state)
  636.     {
  637.       error_state = 0;
  638.       run_unwind_frame ("tree_try_catch::eval");
  639.     }
  640.   else
  641.     {
  642.       error_state = 0;
  643.       discard_unwind_frame ("tree_try_catch::eval");
  644.     }
  645. }
  646.  
  647. void
  648. tree_try_catch_command::accept (tree_walker& tw)
  649. {
  650.   tw.visit_try_catch_command (*this);
  651. }
  652.  
  653. // Simple exception handling.
  654.  
  655. tree_unwind_protect_command::~tree_unwind_protect_command (void)
  656. {
  657.   delete unwind_protect_code;
  658.   delete cleanup_code;
  659. }
  660.  
  661. static void
  662. do_unwind_protect_cleanup_code (void *ptr)
  663. {
  664.   tree_statement_list *list = (tree_statement_list *) ptr;
  665.  
  666.   // We want to run the cleanup code without error_state being set,
  667.   // but we need to restore its value, so that any errors encountered
  668.   // in the first part of the unwind_protect are not completely
  669.   // ignored.
  670.  
  671.   unwind_protect_int (error_state);
  672.   error_state = 0;
  673.  
  674.   // Similarly, if we have seen a return or break statement, allow all
  675.   // the cleanup code to run before returning or handling the break.
  676.   // We don't have to worry about continue statements because they can
  677.   // only occur in loops.
  678.  
  679.   unwind_protect_int (returning);
  680.   returning = 0;
  681.  
  682.   unwind_protect_int (breaking);
  683.   breaking = 0;
  684.  
  685.   if (list)
  686.     list->eval (true);
  687.  
  688.   // This is the one for breaking.  (The unwind_protects are popped
  689.   // off the stack in the reverse of the order they are pushed on).
  690.  
  691.   // XXX FIXME XXX -- inside an unwind_protect, should break work like
  692.   // a return, or just jump to the end of the unwind_protect block?
  693.   // The following code makes it just jump to the end of the block.
  694.  
  695.   run_unwind_protect ();
  696.   if (breaking)
  697.     breaking--;
  698.  
  699.   // This is the one for returning.
  700.  
  701.   if (returning)
  702.     discard_unwind_protect ();
  703.   else
  704.     run_unwind_protect ();
  705.  
  706.   // We don't want to ignore errors that occur in the cleanup code, so
  707.   // if an error is encountered there, leave error_state alone.
  708.   // Otherwise, set it back to what it was before.
  709.  
  710.   if (error_state)
  711.     discard_unwind_protect ();
  712.   else
  713.     run_unwind_protect ();
  714. }
  715.  
  716. void
  717. tree_unwind_protect_command::eval (void)
  718. {
  719.   add_unwind_protect (do_unwind_protect_cleanup_code, cleanup_code);
  720.  
  721.   if (unwind_protect_code)
  722.     unwind_protect_code->eval (true);
  723.  
  724.   run_unwind_protect ();
  725. }
  726.  
  727. void
  728. tree_unwind_protect_command::accept (tree_walker& tw)
  729. {
  730.   tw.visit_unwind_protect_command (*this);
  731. }
  732.  
  733. // No-op.
  734.  
  735. void
  736. tree_no_op_command::accept (tree_walker& tw)
  737. {
  738.   tw.visit_no_op_command (*this);
  739. }
  740.  
  741. // Break.
  742.  
  743. void
  744. tree_break_command::eval (void)
  745. {
  746.   if (! error_state)
  747.     breaking = 1;
  748. }
  749.  
  750. void
  751. tree_break_command::accept (tree_walker& tw)
  752. {
  753.   tw.visit_break_command (*this);
  754. }
  755.  
  756. // Continue.
  757.  
  758. void
  759. tree_continue_command::eval (void)
  760. {
  761.   if (! error_state)
  762.     continuing = 1;
  763. }
  764.  
  765. void
  766. tree_continue_command::accept (tree_walker& tw)
  767. {
  768.   tw.visit_continue_command (*this);
  769. }
  770.  
  771. // Return.
  772.  
  773. void
  774. tree_return_command::eval (void)
  775. {
  776.   if (! error_state)
  777.     returning = 1;
  778. }
  779.  
  780. void
  781. tree_return_command::accept (tree_walker& tw)
  782. {
  783.   tw.visit_return_command (*this);
  784. }
  785.  
  786. /*
  787. ;;; Local Variables: ***
  788. ;;; mode: C++ ***
  789. ;;; End: ***
  790. */
  791.